home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1997 #3 / Amiga Plus CD - 1997 - No. 03.iso / pd / programmierung / alienbreed3d2_src / amos / 256lit.amos / 256lit.amosSourceCode next >
AMOS Source Code  |  1997-01-31  |  7KB  |  281 lines
  1. Screen Open 7,640,24,2,Hires : Wait Vbl : Curs Off : Flash Off : Extension_12_0380 -1
  2. Palette $8,$FF0 : Paper 0 : Pen 1 : Ink 1 : Box 0,4 To 639,20
  3.  
  4. Reserve As Work 14,640*640+12
  5. 'Reserve As Work 13,4096 
  6. Reserve As Work 12,40960
  7. Trap Pload "ab3:includes/shadepal.aminc",6
  8. If Errtrap
  9.    _TEMPSCR=Screen : Screen To Front 7 : Screen 7 : Locate 1,1 : Print Space$(78);
  10.    Locate 1,1 : Centre "Unable to load 'ab3:includes/shadepal.aminc'"
  11.    Screen _TEMPSCR
  12.    Wait Key 
  13.    Edit 
  14. End If 
  15. Screen Open 0,640,640,32,Lowres
  16. Curs Off : Flash Off : Cls 0
  17. Wait Vbl 
  18. Screen Open 1,640,640,32,Lowres
  19. Curs Off : Flash Off : Cls 0
  20. Wait Vbl 
  21. Screen Open 2,640,640,32,Lowres
  22. Curs Off : Flash Off : Cls 0
  23. Wait Vbl 
  24. Screen Open 3,640,640,32,Lowres
  25. Curs Off : Flash Off : Cls 0
  26. Wait Vbl 
  27. Screen Open 4,640,640,32,Lowres
  28. Curs Off : Flash Off : Cls 0
  29. Wait Vbl 
  30. Screen Open 5,640,32,2,Lowres
  31. Screen Display 5,,200,,
  32. Curs Off : Flash Off : Cls 0
  33. Colour 1,$FFF
  34. Dim SHIN(7)
  35. Dim CO(63),PAL(255,2),PR(31),PG(31),PB(31)
  36. Global WOF,HOF,CO(),PAL(),PR(),PG(),PB(),SHIN(),JUSTPAL
  37. Trap Bload "ab3:includes/256pal",Start(14)
  38. If Errtrap
  39.    _TEMPSCR=Screen : Screen To Front 7 : Screen 7 : Locate 1,1 : Print Space$(78);
  40.    Locate 1,1 : Centre "Unable to load 'ab3:includes/256pal'"
  41.    Screen _TEMPSCR
  42.    Wait Key : Edit 
  43. End If 
  44. S=Start(14)
  45. For A=0 To 255
  46.    PAL(A,0)=Deek(S) : Add S,2
  47.    PAL(A,1)=Deek(S) : Add S,2
  48.    PAL(A,2)=Deek(S) : Add S,2
  49. Next 
  50. Dim RM(48)
  51. T=0
  52. For A=0 To 6
  53.    Read A$
  54.    For B=1 To 7
  55.       C=Asc(Mid$(A$,B,1))
  56.       If C>=65 Then C=C-65 Else C=(C-48)+26
  57.       RM(T)=C
  58.       Add T,1
  59.    Next 
  60. Next 
  61.  
  62. Data "BCAAAEF"
  63. Data "GBCDEFK"
  64. Data "LGHIJKR"
  65. Data "LMNOPQR"
  66. Data "LSTUVWR"
  67. Data "SXYZ01W"
  68. Data "XY22201"
  69.  
  70. Repeat 
  71.    F$=Fsel$("ab3:hqn/","","Load Object Graphics")
  72.    If F$="" Then End 
  73.    ' Load Iff F$,0
  74.    F$=F$-".dat"
  75.    F$=F$-".wad"
  76.    F$=F$-".pal"
  77.    F$=F$-".ptr"
  78.    F$=F$-".HQN"
  79.    F$=F$-".top"
  80.    F$=F$-".bot"
  81.    F$=F$-".lft"
  82.    F$=F$-".rgt"
  83.    Screen 0
  84.    Trap Load Iff(F$+".top")
  85.    _CHECKERR[F$+".top"]
  86.    Screen 1
  87.    Load Iff(F$+".bot")
  88.    _CHECKERR[F$+".top"]
  89.    Screen 2
  90.    Load Iff(F$+".lft")
  91.    _CHECKERR[F$+".top"]
  92.    Screen 3
  93.    Load Iff(F$+".rgt")
  94.    _CHECKERR[F$+".top"]
  95.    Screen 4
  96.    Load Iff(F$+".cmp")
  97.    _CHECKERR[F$+".top"]
  98.    
  99.    
  100.    Trap Bload F$+".cmp",Start(14)
  101.    _CHECKERR[F$+".cmp"]
  102.    S=Hunt(Start(14) To Start(14)+10000,"CMAP")+8
  103.    For A=0 To 31
  104.       PR(A)=Peek(S) : Add S,1
  105.       PG(A)=Peek(S) : Add S,1
  106.       PB(A)=Peek(S) : Add S,1
  107.    Next 
  108.    
  109.    
  110.    For A=0 To 31 : CO(A)=Colour(A)
  111.    Next 
  112.    Screen 5
  113.    Screen To Front 5
  114.    
  115.    Screen To Front 7 : Screen 7 : Locate 1,1 : Print Space$(78);
  116.    Locate 1,1 : Centre "Just regenerate palette? (Y/N)"
  117.    Repeat 
  118.       A$=Upper$(Inkey$)
  119.       Multi Wait 
  120.    Until Instr("YN",A$)
  121.    If A$="Y" Then JUSTPAL=1 Else JUSTPAL=0
  122.    
  123.    
  124.    
  125.    If JUSTPAL=0
  126.       Locate 1,1 : Print Space$(78); : Locate 1,1 : Input "Screen Width: ";WOS
  127.       Locate 1,1 : Print Space$(78); : Locate 1,1 : Input "Number of frames: ";NOF
  128.       Locate 1,1 : Print Space$(78); : Locate 1,1 : Input "Width of each frame: ";WOF
  129.       Locate 1,1 : Print Space$(78); : Locate 1,1 : Input "Height of each frame: ";HOF
  130.    End If 
  131.    
  132.    '   For A=1 To 7 
  133.    '      Screen 4
  134.    '      For B=0 To 7
  135.    '         If B<>A Then Colour B,0 Else Colour B,CO(B)
  136.    '      Next  
  137.    '      Screen 5
  138.    '      Input "Shininess of colour (0-16): ";SHIN(A)
  139.    '   Next 
  140.    
  141.    Screen 4
  142.    For A=0 To 7 : Colour A,CO(A) : Next 
  143.    
  144.    Screen 5
  145.    Cls 0
  146.    
  147.    If JUSTPAL=0
  148.       Screen 7 : Locate 1,1 : Print Space$(78); : Locate 1,1
  149.       Centre "Creating lightmap..."
  150.       X=0 : Y=0
  151.       Z=Start(14)+6
  152.       For A=0 To NOF-1
  153.          For Q=0 To WOF-1
  154.             For W=0 To HOF-1
  155.                Screen 0 : CT= Extension_12_044C(Q+X,W+Y)/9
  156.                Screen 1 : CB= Extension_12_044C(Q+X,W+Y)/9
  157.                Screen 2 : CL= Extension_12_044C(Q+X,W+Y)
  158.                Screen 3 : CR= Extension_12_044C(Q+X,W+Y)
  159.                CL=CL/9 : CR=CR/9
  160.                Screen 4 : CC= Extension_12_044C(Q+X,W+Y)
  161.                If CC<>0
  162.                   '                  Add CT,-1 
  163.                   '                  Add CB,-1 
  164.                   '                  Add CL,-1 
  165.                   '                  Add CR,-1 
  166.                   C=RM((3+CB-CT)*7+3+CR-CL)
  167.                Else 
  168.                   C=0
  169.                End If 
  170.                Poke Z,(C*8)+CC
  171.                Add Z,1
  172.                 Extension_12_036E Q+X,W+Y,0
  173.             Next 
  174.          Next 
  175.          X=X+WOF : If X+WOF>WOS : X=0 : Add Y,HOF : End If 
  176.       Next 
  177.       
  178.    End If 
  179.    
  180.    F$=Fsel$("ab3:includes/","","Save raw data file")
  181.    If F$="" Then End 
  182.    PSAVE[F$,NOF]
  183.    Screen 7
  184.    Locate 1,1 : Print Space$(78);
  185.    Locate 1,1 : Centre "All done, press any key to continue"
  186.    Wait Key 
  187.    Locate 1,1 : Print Space$(78);
  188.    Locate 1,1 : Centre "Press return, or select cancel to quit"
  189. Until 0
  190. Edit 
  191.  
  192. Procedure PSAVE[M$,NO]
  193.    
  194.    If JUSTPAL=0
  195.       
  196.       L=(NO*WOF*HOF)-1
  197.       '
  198.       T=0
  199.       P=Start(12)
  200.       '
  201.       
  202.       S=Start(14)
  203.       Doke S,NO
  204.       Doke S+2,WOF
  205.       Doke S+4,HOF
  206.       Add S,6
  207.       Add S,L
  208.       Trap Bsave M$+".HQN",Start(14) To S
  209.       If Errtrap
  210.          _TEMPSCR=Screen : Screen 7 : Locate 1,1 : Print Space$(78);
  211.          Locate 1,1 : Centre "Unable to save "+M$+".HQN"
  212.          Screen _TEMPSCR
  213.          Wait Key : Edit 
  214.       End If 
  215.    End If 
  216.    
  217.    N=Start(12)+32*8*4
  218.    
  219.    Loke Start(6),Varptr(PAL(0,0))
  220.    Loke Start(6)+4,Varptr(PR(0))
  221.    Loke Start(6)+8,Varptr(PG(0))
  222.    Loke Start(6)+12,Varptr(PB(0))
  223.    
  224.    Loke Start(6)+16,Start(12)
  225.    
  226.    _TEMPSCR=Screen : Screen 7 : Locate 1,1 : Print Space$(78);
  227.    Locate 1,1 : Centre "Calculating palette, this may take some time..."
  228.    Screen _TEMPSCR
  229.    
  230.    Call Start(6)+20
  231.    
  232.    '   For PA=0 To 3
  233.    '      For A=0 To 31 
  234.    '         V=32-A 
  235.    '         For Q=0 To 7 
  236.    '            R=PR(Q+PA*8) : G=PG(Q+PA*8) : B=PB(Q+PA*8)
  237.    '            If A>=SHIN(Q) 
  238.    '               R=(R*(V-SHIN(Q)))/(32-SHIN(Q)) 
  239.    '               G=(G*(V-SHIN(Q)))/(32-SHIN(Q)) 
  240.    '               B=(B*(V-SHIN(Q)))/(32-SHIN(Q)) 
  241.    '            Else  
  242.    '               L=V-(32-SHIN(Q)) 
  243.    '               R=Min(255,R+L*5) 
  244.    '               G=Min(255,G+L*5) 
  245.    '               B=Min(255,B+L*5) 
  246.    '            End If  
  247.    '            DQ=10000000 
  248.    '            TC=0
  249.    '            For Z=0 To 255
  250.    '               DR=(R-R(Z))^2
  251.    '               DG=Abs(G-G(Z))^2 
  252.    '               DB=Abs(B-B(Z))^2 
  253.    '                
  254.    '               ND=(DR*3)+(DG*3)+(DB*3)
  255.    '               If ND<DQ Then DQ=ND : TC=Z 
  256.    '            Next  
  257.    '            
  258.    '            Poke N,TC 
  259.    '            Add N,1 
  260.    '         Next 
  261.    '      Next  
  262.    '   Next   
  263.    
  264.    Trap Bsave M$+".256pal",Start(12) To N
  265.    If Errtrap
  266.       _TEMPSCR=Screen : Screen 7 : Locate 1,1 : Print Space$(78);
  267.       Locate 1,1 : Centre "Unable to save "+M$+".256pal"
  268.       Screen _TEMPSCR
  269.       Wait Key 
  270.       Edit 
  271.    End If 
  272. End Proc
  273. '
  274. Procedure _CHECKERR[A$]
  275.    If Errtrap
  276.       _TEMPSCR=Screen : Screen To Front 7 : Screen 7 : Locate 1,1 : Print Space$(78);
  277.       Locate 1,1 : Centre "Unable to load "+F$
  278.       Screen _TEMPSCR
  279.       Wait Key : Edit 
  280.    End If 
  281. End Proc